home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-04
/
bipl.zip
/
PROGS.ZIP
/
CONMAN.ICN
< prev
next >
Wrap
Text File
|
1992-09-28
|
13KB
|
418 lines
############################################################################
#
# File: conman.icn
#
# Subject: Program to convert units
#
# Author: William E. Drissel
#
# Date: June 10, 1988
#
###########################################################################
#
# Conman is a toy I used to teach myself elementary Icon. I
# once vaguely heard of a program which could respond to queries
# like "? Volume of the earth in tbsp".
#
# The keywords of the language (which are not reserved) are:
#
# load
# save
# print
# ? (same as print)
# list
# is and are which have the same effect
#
# "Load" followed by an optional filename loads definitions of
# units from a file. If filename is not supplied, it defaults to
# "conman.sav"
#
# "Save" makes a file for "load". Filename defaults to
# "conman.sav". "Save" appends to an existing file so a user
# needs to periodically edit his save file to prune it back.
#
# "Print" and "?" are used in phrases like:
#
# ? 5 minutes in seconds
#
# Conman replies:
#
# 5 minutes in seconds equals 300
#
# List puts up on the screen all the defined units and the
# corresponding values. Format is same as load/store format.
#
# "Is" and "are" are used like this:
#
# 100 cm are 1 meter
#
# The discovery of is or are causes the preceeding token (in
# this case "cm") to be defined. The load/store format is:
#
# unitname "is" value
#
# Examples:
#
# 8 furlongs is 1 mile
# furlong is 1 / 8 mile
#
# These last two are equivalent. Note spaces before and after
# "/". Continuing examples:
#
# 1 fortnight is 14 days
# furlong/fortnight is furlong / fortnight
# inches/hour is inch / hour
#
# After this a user might type:
#
# ? 1 furlong/fortnight in inches/hour
# Conman will reply:
#
# 1 furlong/fortnight in inches/hour equals 23.57
#
# Note: the following feature of Conman: his operators have no
# precedence so the line above gets the right answer but
#
# 1 furlong/fortnight in inches / hour
#
# gets the wrong answer. (One definition of a feature is a flaw we're
# not going to fix).
#
############################################################################
#
# Requires data: conman.sav
#
############################################################################
#
# Program Notes:
#
# The procedure, process, parses the user's string to see if it
# begins with a keyword. If so, it acts accordingly. If not,
# the user string is fed to isare.
#
# Isare attempts to find "is" or "are" in the users string.
# Failing to, isare feeds the string to conman which can
# interpret anything. If "is" or "are" is found, the tokens
# (delimited by blanks) before the "is" or "are" are stacked in
# foregoing; those after are stacked in subsequent. Then the
# name to be defined is popped off the foregoing and used as
# the "index" into a table named values. The corresponding
# number is computed as eval(subsequent) / eval(foregoing).
#
# The procedure, stack, is based on Griswold and Griswold, "The
# Icon Programming Language", p122.
#
# The procedure, eval, unstacks the tokens from a stack one by
# one until all have been considered. First, the tokens which
# signify division by the next token are considered and used to
# set a switch named action. Then depending on action, the
# token is used to multiply the accumulator or divide it. If
# eval can make the token into a number, the number is used,
# failing that the token is looked up in the table named values
# and the corresponding number is used. Failing both of those,
# conman gripes to the user and does nothing (in effect
# multiplying or dividing by 1). Finally, eval returns the
# number accumulated by the operations with the tokens.
#
# Load defaults the filename to conman.sav if the user didn't
# supply one. Each line read is fed to isare. We will see
# that save prepares the lines so isare can define the units.
#
# Save uses Icon's sort to go thru the table "values". The
# unit name is the left of a pair and the number stored is the
# right of the pair. The word " is " is stuck between them so
# isare will work.
#
# Finally, we consider the procedure conman. During initial
# design, this was perceived to be the largest part of the
# effort of conman. It is a real tribute to the power of Icon
# that only one non-trivial line of code is required. The
# user's string is reproduced then the word "equals" followed
# the result produced by eval after the user's string is
# stacked.
#
############################################################################
global values, blank, nonblank
procedure main (args)
local line
if map(args[1]) == "-t" then &trace := -1
init()
while line := prompt() do {
process(line || " ") # pad with a blank to make life easy
}
windup()
end
#########################################################################
#
# windup
#
procedure windup()
write(&errout,"windup")
end
#########################################################################
#
# process
#
procedure process(str)
case parse(str) of {
"load" : load(str)
"save" : save(str)
"print" : conman(butfirst(str)) # strip first token
"list" : zlist()
default : isare(str) # didn't start with a kw, try is or are
}
end
#########################################################################
#
# parse
#
procedure parse(str)
local token
token := first(str)
case token of {
"?" : return "print" # only special case at present
default : return token
}
end
#########################################################################
#
# conman
#
# compute and write result - During initial design, this was perceived to
# require 50 lines of complicated lookup etc.!
#
procedure conman(strn)
write (strn , " equals ", eval(stack(strn, 1, *strn)))
end
#########################################################################
#
# isare - routine to define values - tries to evaluate if not a definition
#
# locate is,are - delete
# backup one word - save, delete
# compute foregoing
# compute subsequent
# store word, subsequent/foregoing in values
#
procedure isare(str)
local after, before, foregoing, subsequent
# locate blank-delimited is or are - early (?clumsy) Icon code replaced at
# the suggestion of one of REG's students
if (str ? (before := tab(find(" is ")) & move(4) &
after := \tab(0))) then { } # is
else if (str ? (before := tab(find(" are ")) & move(5) &
after := \tab(0))) then { } # are
else { # found nothing - try to eval anyhow
conman(str)
return
}
#
# here if is or are
#
foregoing := stack(before) # so we can look back one token
subsequent := stack(after) # might as well stack this too
name := singular(pop(foregoing)) # define token before is or are
#
# next line so we can support "100 cms are 1 meter"
#
values[name] := eval(subsequent) / eval(foregoing)
return
end
#########################################################################
#
# stack - stack tokens - based on IPL section 12.1 p122
#
# stack the "words" in str - needs cset nonblank
#
procedure stack(str)
local i, j, words
words := [] ; i := 1
while j := upto(nonblank, str, i) do {
i := many(nonblank, str, j)
push(words, str[i:j])
}
return words
end
#########################################################################
#
# eval - evaluate a stack
#
# while more remain
# unstack a token
# if "in" or "over" or "/", set to divide next time
# else if number multiply/divide it
# else if in values, multiply/divide value
# else gripe and leave accum alone
#
procedure eval(stk)
local accum, action, token
accum := 1.0 ; action := "multiply"
while token := singular(pull(stk)) do {
if token == ("in" | "over" | "/" )then action := "divide"
else if action == "multiply" then {
# write("multiplying by ", token, " ", (real(token) |
# real(values[token]) |
# "unknown"))
if not (accum *:= \(real(token) | real(values[token]))) then
write (&errout,
"Can't evaluate ", token, " - using 1.0 instead")
}
else if action == "divide" then {
action := "multiply"
if not (accum /:= \(real(token) | real(values[token]))) then
write (&errout,
"Can't evaluate ", token, " - using 1.0 instead")
}
}#........................................ # end of while more tokens
return accum
end
#########################################################################
#
# init
#
procedure init()
write(&errout, "Conman version 1.1, 7/24/87")
values := table(&null)
nonblank := &ascii -- ' '
blank := ' '
values["times"] := 1.0
values["by"] := 1.0
values["of"] := 1.0
values["at"] := 1.0
values["print"] := 1.0
values["?"] := 1.0
values["meter"] := 1.0
values["kilogram"] := 1.0
values["second"] := 1.0
end
#########################################################################
#
# prompt
#
procedure prompt()
return read()
end
#########################################################################
#
# load - loads table from a file - assumes save format compatible
# with isare
#
procedure load(str)
local intext, line, filnam
filnam := (\second(str) | "conman.sav")
write (&errout, "Load from ", filnam, ". May take a minute or so.")
intext := open(filnam,"r") | { write(&errout, "can't open ", filnam)
fail}
while line := read(intext) do {
isare(line || " ") # pad with a blank to make life easy
}
close(intext)
return
end
#########################################################################
#
# save - saves table to file in format compatible with isare
#
procedure save(str)
local i, outtext, pair, wlist, filnam
filnam := (\second(str) | "conman.sav")
write (&errout, "Save into ", filnam)
outtext := open(filnam,"a") | { write(&errout, "can't save to ", filnam)
fail}
wlist := sort(values)
i := 0
every pair := !wlist do {
write(outtext, pair[1], " is ", pair[2])
}
close(outtext)
end
#########################################################################
#
# zlist - lists the table
#
procedure zlist()
local i, pair, wlist
i := 0
wlist := sort(values)
every pair := !wlist do {
write(&errout, pair[1], " is ", pair[2])
}
end
#########################################################################
#
# first - returns first token in a string - needs cset nonblank
#
procedure first(s)
local stuff
s? (tab(upto(nonblank)) , (stuff := tab(many(nonblank))))
return \stuff
end
#########################################################################
#
# second - returns second token in a string - needs cset nonblank
#
procedure second(s)
local stuff
s? (tab(upto(nonblank)) , (tab(many(nonblank)) & tab(upto(nonblank)) &
(stuff := tab(many(nonblank)))))
return \stuff
end
#########################################################################
#
# butfirst - returns all butfirst token in a string - needs cset nonblank
#
procedure butfirst(s)
local stuff
s? (tab(upto(nonblank)) , tab(many(nonblank)) & tab(upto(nonblank)) &
(stuff := tab(0)))
return \stuff
end
#########################################################################
#
# singular - returns singular of a unit of measure - add special cases in
# an obvious way. Note: singulars ending in "e" should be handled
# here also "per second" units which end in "s".
#
procedure singular(str)
local s
s := str
if s == "fps" then return "fps"
if s == "feet" then return "foot"
if s == "minutes" then return "minute"
if s == "miles" then return "mile"
#
## otherwise strip "es" or "s". Slick code by Icon grad student
#
return s? (1(tab(-2), ="es") | 1(tab(-1), ="s" ) | tab(0))
end
################################### FINIS ##################################